home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_ghostscript.idb / usr / freeware / lib / ghostscript / 3.33 / font2c.ps.z / font2c.ps
Encoding:
Text File  |  1998-05-21  |  17.6 KB  |  641 lines
  1. %    Copyright (C) 1992, 1993, 1994, 1995 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of GNU Ghostscript.
  4. % 
  5. % GNU Ghostscript is distributed in the hope that it will be useful, but
  6. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility to
  7. % anyone for the consequences of using it or for whether it serves any
  8. % particular purpose or works at all, unless he says so in writing.  Refer
  9. % to the GNU Ghostscript General Public License for full details.
  10. % 
  11.  
  12. % font2c.ps
  13. % Write out a PostScript Type 0 or Type 1 font as C code
  14. % that can be linked with the interpreter.
  15. % This even works on protected fonts, if you use the -dWRITESYSTEMDICT
  16. % switch in the command line.  The code is reentrant and location-
  17. % independent and has no external references, so it can be put into
  18. % a sharable library even on VMS.
  19.  
  20. % Define the maximum string length that all compilers will accept.
  21. % This must be approximately
  22. %    min(max line length, max string literal length) / 4 - 5.
  23.  
  24. /font2cdict 100 dict dup begin
  25.  
  26. /max_wcs 50 def
  27.  
  28. % Define a temporary file for writing out procedures.
  29. /wtempname (_.tmp) def
  30.  
  31. % ------ Protection utilities ------ %
  32.  
  33. % Protection values are represented by a mask:
  34. /a_noaccess 0 def
  35. /a_executeonly 1 def
  36. /a_readonly 3 def
  37. /a_all 7 def
  38. /prot_names
  39.  [ (0) (a_execute) null (a_readonly) null null null (a_all)
  40.  ] def
  41. /prot_opers
  42.  [ {noaccess} {executeonly} {} {readonly} {} {} {} {}
  43.  ] def
  44.  
  45. % Get the protection of an object.
  46.    /getpa
  47.     { dup wcheck
  48.        { pop a_all }
  49.        {    % Check for executeonly or noaccess objects in protected.
  50.          dup protected exch known
  51.       { protected exch get }
  52.       { pop a_readonly }
  53.      ifelse
  54.        }
  55.       ifelse
  56.     } bind def
  57.  
  58. % Get the protection appropriate for (all the) values in a dictionary.
  59.    /getva
  60.     { a_noaccess exch
  61.        { exch pop
  62.          dup type dup /stringtype eq 1 index /arraytype eq or
  63.      exch /packedarraytype eq or
  64.       { getpa a_readonly and or }
  65.       { pop pop a_all exit }
  66.      ifelse
  67.        }
  68.       forall
  69.     } bind def
  70.  
  71. % Keep track of executeonly and noaccess objects,
  72. % but don't let the protection actually take effect.
  73. .currentglobal
  74. false .setglobal    % so protected can reference local objs
  75. /protected        % do first so // will work
  76.   systemdict wcheck { 1500 dict } { 1 dict } ifelse
  77. def
  78. systemdict wcheck not
  79.  { (Warning: you will not be able to convert protected fonts.\n) print
  80.    (If you need to convert a protected font, please\n) print
  81.    (restart the program and specify the -dWRITESYSTEMDICT switch.\n) print
  82.    flush
  83.    (%end) .skipeof
  84.  }
  85. if
  86. userdict begin
  87.   /executeonly
  88.    { dup //protected exch //a_executeonly put readonly
  89.    } bind def
  90.   /noaccess
  91.    { dup //protected exch //a_noaccess put readonly
  92.    } bind def
  93. end
  94. true .setglobal
  95. systemdict begin
  96.   /executeonly
  97.    { userdict /executeonly get exec
  98.    } bind odef
  99.   /noaccess
  100.    { userdict /noaccess get exec
  101.    } bind odef
  102. end
  103. %end
  104. .setglobal
  105.  
  106. % ------ Output utilities ------ %
  107.  
  108. % By convention, the output file is named cfile.
  109.  
  110. % Define some utilities for writing the output file.
  111.    /wtstring 100 string def
  112.    /wb {cfile exch write} bind def
  113.    /ws {cfile exch writestring} bind def
  114.    /wl {ws (\n) ws} bind def
  115.    /wt {wtstring cvs ws} bind def
  116.  
  117. % Write a C string.  Some compilers have unreasonably small limits on
  118. % the length of a string literal or the length of a line, so every place
  119. % that uses wcs must either know that the string is short,
  120. % or be prepared to use wcca instead.
  121.    /wbx
  122.     { 8#1000 add 8 (0000) cvrs dup 0 (\\) 0 get put ws
  123.     } bind def
  124.    /wcst
  125.     [
  126.       32 { /wbx load } repeat
  127.       95 { /wb load } repeat
  128.       129 { /wbx load } repeat
  129.     ] def
  130.    ("\\) { wcst exch { (\\) ws wb } put } forall
  131.    /wcs
  132.     { (") ws { dup wcst exch get exec } forall (") ws
  133.     } bind def
  134.    /can_wcs    % Test if can use wcs
  135.     { length max_wcs le
  136.     } bind def
  137.    /wncs    % name -> C string
  138.     { wtstring cvs wcs
  139.     } bind def
  140. % Write a C string as an array of character values.
  141. % We only need this because of line and literal length limitations.
  142.    /wca        % string prefix suffix ->
  143.     { 0 4 -2 roll exch
  144.        { exch ws
  145.          exch dup 19 ge { () wl pop 0 } if 1 add
  146.      exch dup 32 ge 1 index 126 le and
  147.       { 39 wb dup 39 eq 1 index 92 eq or { 92 wb } if wb 39 wb }
  148.           { wt }
  149.          ifelse (,)
  150.        } forall
  151.       pop pop ws
  152.     } bind def
  153.    /wcca
  154.     { ({\n) (}) wca
  155.     } bind def
  156.  
  157. % Write object protection attributes.  Note that dictionaries are
  158. % the only objects that can be writable.
  159.    /wpa
  160.     { dup xcheck { (a_executable|) ws } if
  161.       dup type /dicttype eq { getpa } { getpa a_readonly and } ifelse
  162.       prot_names exch get ws
  163.     } bind def
  164.    /wva
  165.     { getva prot_names exch get ws
  166.     } bind def
  167.  
  168. % ------ Object writing ------ %
  169.  
  170.    /wnstring 128 string def
  171.  
  172. % Write a string/name or null as an element of a string/name/null array. */
  173.    /wsn
  174.     { dup null eq
  175.        { pop (\t255,255,) wl
  176.        }
  177.        { dup type /nametype eq { wnstring cvs } if
  178.          dup length 256 idiv wt (,) ws
  179.      dup length 256 mod wt
  180.      (,) (,\n) wca
  181.        }
  182.       ifelse
  183.     } bind def
  184. % Write a packed string/name/null array.
  185.    /wsna    % <name> <(string|name|null)*> wsna -
  186.     { (\tstatic const char ) ws exch wt ([] = {) wl
  187.       { wsn } forall
  188.       (\t0\n};) wl
  189.     } bind def
  190.  
  191. % Write a number or an array of numbers, as refs.
  192. /isnumber
  193.  { type dup /integertype eq exch /realtype eq or
  194.  } bind def
  195. /wnums
  196.  { dup isnumber
  197.     { (real_v\() ws wt (\),) ws }
  198.     { { wnums } forall }
  199.    ifelse
  200.  } bind def
  201.  
  202. % Test whether a procedure element can be written (printed).
  203. /iswx 4 dict dup begin
  204.   /arraytype { { iswproc } isall } def
  205.   /nametype { pop true } def
  206.   /operatortype { pop true } def    % assume it has been bound in
  207.   /packedarraytype /arraytype load def
  208. end def
  209. /iswnx 4 dict dup begin
  210.   /integertype { pop true } def
  211.   /nametype { pop true } def
  212.   /realtype { pop true } def
  213.   /stringtype { pop true } def
  214. end def
  215. /iswproc    % <obj> isproc <bool>
  216.  { dup xcheck { iswx } { iswnx } ifelse
  217.    1 index type .knownget { exec } { pop false } ifelse
  218.  } bind def
  219.  
  220. % Write a printable procedure (one for which iswproc returns true).
  221. /wproca 3 dict dup begin
  222.   /arraytype
  223.    { 1 index ({) writestring
  224.       { 1 index ( ) writestring 1 index exch wproc } forall
  225.      (}) writestring
  226.    } bind def
  227.   /packedarraytype /arraytype load def
  228.   /operatortype { .writecvs } bind def    % assume binding would work
  229. end def
  230. /wproc        % <file> <proc> wproc -
  231.  { dup type wproca exch .knownget { exec } { write==only } ifelse
  232.  } bind def
  233.  
  234. % Write a named object.  Return true if this was possible.
  235. % Legal types are: boolean, integer, name, real, string,
  236. % array of (integer, integer+real, name, null+string),
  237. % and certain procedures (see iswproc above).
  238. % All other objects are either handled specially or ignored.
  239.    /isall    % <array> <proc> isall <bool>
  240.     { true 3 -1 roll
  241.        { 2 index exec not { pop false exit } if }
  242.       forall exch pop
  243.     } bind def
  244.    /wott 8 dict dup begin
  245.       /arraytype
  246.        { woatt
  247.           { aload pop 2 index 2 index exec
  248.          { exch pop exec exit }
  249.          { pop pop }
  250.         ifelse
  251.       }
  252.      forall
  253.        } bind def
  254.       /booleantype
  255.        { { (\tmake_true\(&) } { (\tmake_false\(&) } ifelse ws
  256.          wt (\);) wl true
  257.        } bind def
  258.       /integertype
  259.        { (\tmake_int\(&) ws exch wt (, ) ws
  260.          wt (\);) wl true
  261.        } bind def
  262.       /nametype
  263.        { (\tcode = (*pprocs->name_create)\(&) ws exch wt
  264.          (, ) ws wnstring cvs wcs    % OK, names are short
  265.      (\);) wl
  266.      (\tif ( code < 0 ) return code;) wl
  267.      true
  268.        } bind def
  269.       /packedarraytype
  270.     /arraytype load def
  271.       /realtype
  272.        { (\tmake_real\(&) ws exch wt (, ) ws
  273.          wt (\);) wl true
  274.        } bind def
  275.       /stringtype
  276.        { ({\tstatic const char s_[] = ) ws
  277.          dup dup can_wcs { wcs } { wcca } ifelse
  278.      (;) wl
  279.      (\tmake_const_string\(&) ws exch wt
  280.      (, a_readonly, ) ws length wt (, (const byte *)s_\);) wl
  281.      (}) wl true
  282.        } bind def
  283.    end def
  284. % Write some other kind of object, if known.
  285.    /wother
  286.     { dup otherobjs exch known
  287.        { otherobjs exch get (\t) ws exch wt ( = ) ws wt (;) wl true }
  288.        { pop pop false }
  289.       ifelse
  290.     } bind def
  291. % Top-level procedure.
  292.    /wo        % name obj -> OK
  293.     { dup type wott exch .knownget { exec } { wother } ifelse
  294.     } bind def
  295.  
  296. % Write an array (called by wo).
  297.    /wap        % <name> <array> wap -
  298.     { dup xcheck not 1 index wcheck not and 1 index rcheck and
  299.        { pop pop }
  300.        { (\tr_set_attrs\(&) ws exch wt (, ) ws wpa (\);) wl }
  301.       ifelse
  302.     } bind def
  303.    /wnuma    % name array C_type type_v ->
  304.     { ({\tstatic const ref_\() ws exch ws
  305.       (\) a_[] = {) wl exch
  306.       dup length 0 eq
  307.        { (\t0) wl
  308.        }
  309.        { dup
  310.           { (\t) ws 2 index ws (\() ws wt (\),) wl
  311.       } forall
  312.        }
  313.       ifelse
  314.       (\t};) wl exch pop
  315.       (\tmake_const_array\(&) ws exch wt
  316.       (, avm_foreign|) ws dup wpa (, ) ws length wt
  317.       (, (const ref *)a_\);) wl
  318.       (}) wl
  319.     } bind def
  320.    /woatt [
  321.     % Integers
  322.      { { { type /integertype eq } isall }
  323.        { (long) (integer_v) wnuma true }
  324.      }
  325.     % Integers + reals
  326.      { { { type dup /integertype eq exch /realtype eq or } isall }
  327.        { (float) (real_v) wnuma true }
  328.      }
  329.     % Strings + nulls
  330.      { { { type dup /nulltype eq exch /stringtype eq or } isall }
  331.        { ({) ws dup (sa_) exch wsna
  332.      (\tcode = (*pprocs->string_array_create)\(&) ws exch wt
  333.      (, sa_, ) ws dup length wt (, ) ws wpa (\);) wl
  334.      (\tif ( code < 0 ) return code;) wl
  335.      (}) wl true
  336.        }
  337.      }
  338.     % Names
  339.      { { { type /nametype eq } isall }
  340.        { ({) ws dup (na_) exch wsna
  341.      (\tcode = (*pprocs->name_array_create)\(&) ws 1 index wt
  342.      (, na_, ) ws dup length wt (\);) wl
  343.      (\tif ( code < 0 ) return code;) wl
  344.      wap (}) wl true
  345.        }
  346.      }
  347.     % Procedure
  348.      { { iswproc }
  349.        {    % We'd like to use == and write directly to a string,
  350.         % but we can't do the former because of operators,
  351.         % and we can't do the latter because we can't predict
  352.         % how long the string would have to be....
  353.      wtempname (w) file 2 copy wproc closefile
  354.      wtempname status pop pop pop exch pop string
  355.      wtempname (r) file dup 3 -1 roll readstring pop exch closefile
  356.         % Stack: name proc string
  357.      ({\tstatic const char s_[] = ) ws
  358.          dup dup can_wcs { wcs } { wcca } ifelse
  359.      (;) wl
  360.      (\tcode = (*pprocs->ref_from_string)\(&) ws 2 index wt
  361.      (, s_, ) ws length wt (\);) wl
  362.      (\tif ( code < 0 ) return code;) wl
  363.      wap (}) wl true
  364.      wtempname deletefile
  365.        }
  366.      }
  367.     % Default
  368.      { { pop true }
  369.        { wother }
  370.      }
  371.    ] def
  372.  
  373. % Write a named dictionary.  We assume the ref is already declared.
  374.    /wd        % <name> <dict> <extra> wd -
  375.     { 3 1 roll
  376.       ({) ws
  377.       (\tref v_[) ws dup length wt (];) wl
  378.       dup [ exch
  379.        { counttomark 2 sub wtstring cvs
  380.          (v_[) exch concatstrings (]) concatstrings exch wo not
  381.           { (Skipping ) print ==only (....\n) print }
  382.      if
  383.        } forall
  384.       ]
  385.         % Stack: array of keys (names)
  386.       ({) ws dup (str_keys_) exch wsna
  387.       (\tstatic const cfont_dict_keys keys_ =) wl
  388.       (\t { 0, 0, ) ws length wt (, ) ws 3 -1 roll wt (, ) ws
  389.       dup wpa (, ) ws dup wva ( };) wl pop
  390.       (\tcode = \(*pprocs->ref_dict_create\)\(&) ws wt
  391.       (, &keys_, str_keys_, v_\);) wl
  392.       (\tif (code < 0) return code;) wl
  393.       (}) wl
  394.       (}) wl
  395.     } bind def
  396.  
  397. % Write character dictionary keys.
  398. % We save a lot of space by abbreviating keys which appear in
  399. % StandardEncoding or ISOLatin1Encoding.
  400. % Writes code to declare and initialize enc_keys_, str_keys, and keys_.
  401. /wcdkeys    % <dict> wcdkeys -
  402.  {    % Write keys present in StandardEncoding or ISOLatin1Encoding,
  403.     % pushing other keys on the o-stack.
  404.    (static const charindex enc_keys_[] = {) wl
  405.    dup [ exch 0 exch
  406.     { pop decoding 1 index known
  407.        { decoding exch get ({) ws dup -8 bitshift wt
  408.      (,) ws 255 and wt (}, ) ws
  409.      1 add dup 5 mod 0 eq { (\n) ws } if
  410.        }
  411.        { exch }
  412.       ifelse
  413.     }
  414.    forall pop
  415.    ]
  416.    ({0,0}\n};) wl
  417.     % Write other keys.
  418.    (str_keys_) exch wsna
  419.     % Write the declaration for keys_.
  420.    (static const cfont_dict_keys keys_ = {) wl
  421.    (\tenc_keys_, countof\(enc_keys_\) - 1,) wl
  422.    (\t) ws dup length wt ( - \(countof\(enc_keys_\) - 1\), 0, ) ws
  423.    dup wpa (, ) ws wva () wl
  424.    (};) wl
  425.  } bind def
  426.  
  427. % Enumerate character dictionary values in the same order that
  428. % the keys appear in enc_keys_ and str_keys_.
  429. % <proc> is called with each value in turn.
  430. /cdforall    % <dict> <proc> cdforall -
  431.  { 2 copy
  432.     { decoding 3 index known
  433.        { 3 -1 roll pop exec }
  434.        { pop pop pop }
  435.       ifelse
  436.     }
  437.    /exec cvx 3 packedarray cvx
  438.    /forall cvx
  439.    5 -2 roll
  440.     { decoding 3 index known
  441.        { pop pop pop }
  442.        { 3 -1 roll pop exec }
  443.       ifelse
  444.     }
  445.    /exec cvx 3 packedarray cvx
  446.    /forall cvx
  447.    6 packedarray cvx exec
  448.  } bind def
  449.  
  450. % ------ Writers for special objects ------ %
  451.  
  452. /writespecial 10 dict dup begin
  453.  
  454.    /FontInfo { 0 wd } def
  455.  
  456.    /Private { 0 wd } def
  457.  
  458.    /CharStrings
  459.     { ({) wl
  460.       dup wcdkeys
  461.       (static const char values_[] = {) wl
  462.        { wsn } cdforall
  463.       (\t0\n};) wl
  464.       (\tcode = \(*pprocs->string_dict_create\)\(&) ws wt
  465.       (, &keys_, str_keys_, values_\);) wl
  466.       (\tif ( code < 0 ) return code;) wl
  467.       (}) wl
  468.     } bind def
  469.  
  470.    /Metrics
  471.     { ({) wl
  472.       dup wcdkeys
  473.       (static const ref_(float) values_[] = {) wl
  474.       dup { (\t) ws wnums () wl } cdforall
  475.       (\t0\n};) wl
  476.       (static const char lengths_[] = {) wl
  477.        { (\t) ws dup isnumber
  478.       { pop 0 }
  479.       { length 1 add }
  480.      ifelse wt (,) wl
  481.        } cdforall
  482.       (\t0\n};) wl
  483.       (\tcode = \(*pprocs->num_dict_create\)\(&) ws wt
  484.       (, &keys_, str_keys_, (const ref *)values_, lengths_\);) wl
  485.       (\tif ( code < 0 ) return code;) wl
  486.       (}) wl
  487.     } bind def
  488.  
  489.    /Metrics2 /Metrics load def
  490.  
  491.    /FDepVector pop    % (converted to a list of font names)
  492.  
  493. end def
  494.  
  495. % ------ The main program ------ %
  496.  
  497. % Construct an inverse dictionary of encodings.
  498. [ /StandardEncoding /ISOLatin1Encoding
  499.   /SymbolEncoding /DingbatsEncoding
  500.   /KanjiSubEncoding
  501. ]
  502. dup length dict begin
  503.  { mark exch dup { .findencoding exch def } stopped cleartomark
  504.  } forall
  505. currentdict end /encodingnames exch def
  506.  
  507. % Invert the StandardEncoding and ISOLatin1Encoding vectors.
  508. 512 dict begin
  509.   0 1 255 { dup ISOLatin1Encoding exch get exch 256 add def } for
  510.   0 1 255 { dup StandardEncoding exch get exch def } for
  511. currentdict end /decoding exch def
  512.  
  513. /writefont        % cfilename procname -> [writes the current font]
  514.  { (gsf_) exch concatstrings
  515.      /fontprocname exch def
  516.    /cfname exch def
  517.    /cfile cfname (w) file def
  518.  
  519. % Remove unwanted keys from the font.
  520.    currentfont dup length dict begin { def } forall
  521.     { /FID /MIDVector /CurMID } { currentdict exch undef } forall
  522.    /Font currentdict end def
  523.  
  524. % Replace the FDepVector with a list of font names.
  525.    Font /FDepVector .knownget
  526.     { [ exch { /FontName get } forall ]
  527.       Font /FDepVector 3 -1 roll put
  528.     }
  529.    if
  530.  
  531. % Find all the special objects we know about.
  532. % wo uses this to write out references to otherwise intractable objects.
  533.    /otherobjs writespecial length dict dup begin
  534.      writespecial
  535.       { pop Font 1 index .knownget { exch def } { pop } ifelse
  536.       }
  537.      forall
  538.    end def
  539.  
  540. % Define a dummy FontInfo, in case the font doesn't have one.
  541.    /FontInfo 0 dict def
  542.  
  543. % Write out the boilerplate.
  544.    Font begin
  545.    (/* Portions of this file are subject to the following notice: */) wl
  546.    (/*) wl
  547.    ( * ) ws systemdict /copyright get wl
  548.    ( */) wl
  549.    FontInfo /Notice known
  550.     { (/* Portions of this file are also subject to the following notice: */) wl
  551.       (/****************************************************************) wl
  552.       FontInfo /Notice get wl
  553.       ( ****************************************************************/) wl
  554.     } if
  555.    () wl
  556.    (/* ) ws cfname ws ( */) wl
  557.    (/* This file was created by the ) ws product ws ( font2c utility. */) wl
  558.    () wl
  559.    (#include "ccfont.h") wl
  560.    () wl
  561.  
  562. % Write the procedure prologue.
  563.    (#ifdef __PROTOTYPES__) wl
  564.    (int huge) wl
  565.    fontprocname ws ((const cfont_procs *pprocs, ref *pfont)) wl
  566.    (#else) wl
  567.    (int huge) wl
  568.    fontprocname ws ((pprocs, pfont) const cfont_procs *pprocs; ref *pfont;) wl
  569.    (#endif) wl
  570.    ({\tint code;) wl
  571.    (\tref Font;) wl
  572.    otherobjs
  573.     { exch pop (\tref ) ws wt (;) wl }
  574.    forall
  575.  
  576. % Write out the special objects.
  577.    otherobjs
  578.     { exch writespecial 2 index get exec
  579.     }
  580.    forall
  581.  
  582. % Write out the main font dictionary.
  583. % If possible, substitute the encoding name for the encoding;
  584. % PostScript code will fix this up.
  585.     { /Encoding /PrefEnc }
  586.     { Font 1 index .knownget
  587.        { encodingnames exch .knownget { def } { pop } ifelse }
  588.        { pop }
  589.       ifelse
  590.     }
  591.    forall
  592.    (Font) Font FontType 0 eq { 5 } { 1 } ifelse wd
  593.  
  594. % Finish the procedural initialization code.
  595.    (\t*pfont = Font;) wl
  596.    (\treturn 0;) wl
  597.    (}) wl
  598.    end                % Font
  599.  
  600.    cfile closefile
  601.  
  602.  } bind def
  603.  
  604. end def            % font2cdict
  605.  
  606. % Compute the procedure name from the font name.
  607. /makefontprocname    % fontname -> procname
  608.  { =string cvs
  609.    dup length 1 sub -1 0
  610.     { dup =string exch get 45 eq { =string exch 95 put } { pop } ifelse
  611.     }
  612.    for 
  613.  } def
  614.  
  615. /writefont { font2cdict begin writefont end } def
  616.  
  617. % If the program was invoked from the command line, run it now.
  618. [ shellarguments
  619.  { counttomark dup 2 eq exch 3 eq or
  620.     { counttomark -1 roll cvn
  621.       (Converting ) print dup =only ( font.\n) print flush
  622.       dup FontDirectory exch known { dup FontDirectory exch undef } if
  623.       findfont setfont
  624.       (FontName is ) print currentfont /FontName get ==only (.\n) print flush
  625.       counttomark 1 eq
  626.        {    % Construct the procedure name from the file name.
  627.          currentfont /FontName get makefontprocname
  628.        }
  629.       if
  630.       writefont
  631.       (Done.\n) print flush
  632.     }
  633.     { cleartomark
  634.       (Usage: font2c fontname cfilename.c [shortname]\n) print
  635.       ( e.g.: font2c Courier cour.c\n) print flush
  636.       mark
  637.     }
  638.    ifelse
  639.  }
  640. if pop
  641.